home *** CD-ROM | disk | FTP | other *** search
Text File | 1991-08-25 | 57.3 KB | 1,865 lines |
- Newsgroups: comp.sources.misc
- From: Khun Yee Fung <clipper@csd.uwo.ca>
- Subject: v22i061: perl_archie - an archie client in perl, Part01/01
- Message-ID: <1991Aug25.223459.12192@sparky.IMD.Sterling.COM>
- X-Md4-Signature: 63e8d5c233dc59589d193f222fde4f93
- Date: Sun, 25 Aug 1991 22:34:59 GMT
- Approved: kent@sparky.imd.sterling.com
-
- Submitted-by: Khun Yee Fung <clipper@csd.uwo.ca>
- Posting-number: Volume 22, Issue 61
- Archive-name: perl_archie/part01
- Environment: BSD, Perl
-
- This version is 3.8. Please do not use version 2.x of the perl client
- posted in alt.sources as it is now obselete.
-
- This is an implementation of an archie client in the perl language. It
- is written such that there is no dependancy on the prospero package
- available from june.cs.washington.edu, prospero.tar.Z. As it is
- written in Perl, it is easy to modify the client to your own need.
- Also, the format for the output can be specified by the user. As you
- query the archie server machine without a shell connection, the
- response is quicker, and the result easier to handle.
-
- Please read the README for more details and the man page for
- instruction for using the client. The file archie.examples has a few
- examples.
-
- Please notice that there are two archie clients in C. One is included
- in the prospero distribution. The other is written by Brendan Kehoe. A
- X-based archie client is also coming.
-
- Comments, etc. are welcome. Please send them to clipper@csd.uwo.ca.
-
- Khun Yee
- --
- #! /bin/sh
- # This is a shell archive. Remove anything before this line, then unpack
- # it by saving it into a file and typing "sh file". To overwrite existing
- # files, type "sh file -c". You can also feed this as standard input via
- # unshar, or by typing "sh <file", e.g.. If this archive is complete, you
- # will see the following message at the end:
- # "End of shell archive."
- # Contents: README ACKNOWLEDGE Makefile fixpath archie.files archie
- # archie.l socket.ph resolver.pl newgetopt.pl archie.depend
- # archie.examples DOT.archierc system.archierc
- # Wrapped by clipper@no9sun on Thu Aug 22 02:04:24 1991
- PATH=/bin:/usr/bin:/usr/ucb ; export PATH
- if test -f 'README' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'README'\"
- else
- echo shar: Extracting \"'README'\" \(5726 characters\)
- sed "s/^X//" >'README' <<'END_OF_FILE'
- X# Copyright (C) Khun Yee Fung clipper@csd.uwo.ca 1991
- X# You can do anything to this program except selling it for profit or
- X# pretending you wrote it.
- X# $Id: README,v 3.6 1991/08/03 00:15:22 clipper Exp clipper $
- X
- XThis README file is for version 3.x of the archie program.
- X
- XNew
- X---
- X
- XI forgot to include fixpath and Makefile in the last distribution.
- XSorry. They are now included.
- X
- XChanges for Version 3.6
- X-----------------------
- X
- X1. The -along option is on again. This option is useful for at least
- Xone person and I think is useful if the query dies in midway. At least
- Xa partial result is better than nothing.
- X
- X2. Some other small changes are done.
- X
- X3. Some details in the man page are changed.
- X
- X4. Consider this a gamma release.
- X
- XChanges since version 2.xx
- X--------------------------
- X
- X 1. A sort option is added. The lists can be sorted by the domain of
- X the host or by the date. Reverse ordering is supported too. The host
- X ordering is by a user definable array. This is useful if the list
- X has the domains in order of nearest to farthest from the system the
- X user is using. Check system.archierc to set the system default ordering.
- X
- X 2. Version option is supported. When this option is specified, the
- X version number of the program will be printed.
- X
- X 3. A different startup file can be specified.
- X
- X 4. I have decided not to do packet ordering myself. So the -along
- X option is gone.
- X
- X 5. The part on networking has been completely rewritten. I hope it
- X is more correct than the last two releases.
- X
- X 6. There are other small changes. I can't list them all.
- X
- XI will not add any more features in the program. It is too big even now.
- X
- XFeature not implemented
- X-----------------------
- X
- X I have thought about implementing a auto-ftp option in the program
- X so that the program will ask the user if a file should be transferred
- X from the host by anonymous ftp. I have all the code for a ftp client
- X in perl (I have always used this perl ftp than the standard ftp). I
- X have thought out how it should be implemented. The host sorting
- X method was thought out initially to support this option so that the
- X nearest hosts are always asked first. But the option will add
- X another 10k bytes to the program. I am not happy about the size of
- X the program even now. As we can always set the format of the output
- X to a particular format and pipe the output to another program for
- X anonymous ftp, I have decided against implementing this feature. If
- X you want to implement it, I can supply you the perl ftp client code.
- X
- XBrief Introduction
- X------------------
- X
- XThis is a archie client written in Perl using the prospero protocol.
- XIt is standalone with no dependance on the prospero code in
- Xprospero.tar.Z on june.cs.washington.edu. I am not sure this program
- Xis useful as there is also a standalone archie program in that file
- Xarchive, except that you have to compile the prospero file system too.
- XSo, if you think you are more interested in a C archie client, do grab
- Xthat file archive and install the archie client that comes with it.
- X
- XTo get more information about prospero, you can send a message to
- Xinfo-prospero@isi.edu.
- X
- XAbout Prospero
- X--------------
- X
- XWith prospero, many things that are tedious to do by login
- Xinteractively to an archie server are simple. For example, the output
- Xfrom an archie client using the prospero protocol can be parsed and
- Xfurther processed without going through the mail system. The system
- Xload on the archie server will surely lower because of the absence of
- Xinteractive processes. The attributes of a directory or a file also
- Xmakes the output look like a part of a file system.
- X
- XSystem Requirements
- X-------------------
- X
- X 1. The program probably needs Perl 4.010. Perl 3.044 causes it to
- X core dump.
- X
- XInstallation
- X------------
- X
- XTo start things off, modify the file archie.depend. You should also
- Xmove archie in the directory where you store you perl scripts. The
- Xlibrary files should be in the perl library. If you want to, you can
- Xuse the Makefile in this distribution.
- X
- XPlease also check the file system.archierc. Change the sorting order
- Xof hosts in the domain option. Put the domains nearest to your site in
- Xthe beginning of the option and farthest at the end. For a site in
- XFinland, probably the order is very different, with .de .nl.dk nearer
- Xto the beginning of the list than .ca, .edu, .com, or .ca.
- X
- XAcknowledgement file
- X--------------------
- X
- XI guess I know the header information much better now. The program has
- Xbeen modified. Thanks very much to Clifford Neuman
- X(bcn@cs.washington.edu) for providing information on prospero. Please
- Xread ACKNOWLEDGE for acknowledgements.
- X
- XStatus of the program
- X---------------------
- X
- XThis program is in the gamma testing stage. However, I will not add
- Xany more features. Also, I will only modify the file to correct bugs.
- XThis is basically a stable version. I need people to test, improve,
- Xand suggest, to make it better. It is written on a Sun 3/50. I tried
- Xit on a MIPS RISC/os 4.51. It worked. I have also tried it on a
- XSequent symmetry Dynix Version something. These are the machines that
- XI have access to. Brendan Kehoe reports that it works under some
- XHP's, an Encore, and DecStations too. Peter (poe@daimi.aau.dk) says
- Xit works on his HP9000/300 under HP-UX 7.0 too. Billy Barron says it
- Xworks under Solbourne OS/MP 4.0D. It might not work on other
- Xmachines. If you port it to another machine type, please send me the
- Xdiffs, thanks. If you find bugs on other machine types, please also
- Xtell me. I would like to know how portable the program is.
- X
- XOthers
- X------
- X
- XPlease send your comments, criticisms, diffs, bug reports, etc. to me
- Xat clipper@csd.uwo.ca. Yes, you can even criticise my programming
- Xstyle.
- X
- XKhun Yee
- XAugust 2
- END_OF_FILE
- if test 5726 -ne `wc -c <'README'`; then
- echo shar: \"'README'\" unpacked with wrong size!
- fi
- # end of 'README'
- fi
- if test -f 'ACKNOWLEDGE' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'ACKNOWLEDGE'\"
- else
- echo shar: Extracting \"'ACKNOWLEDGE'\" \(1631 characters\)
- sed "s/^X//" >'ACKNOWLEDGE' <<'END_OF_FILE'
- XSince the program is getting more stable by the day, it is time I add
- Xa little file to acknowledge people that have helped me along the way.
- X
- XForemost, Clifford Neuman (bcn@cs.washington.edu) provides us with the
- Xprospero protocol. This makes the whole thing possible. He provided
- Xall the information I used concerning the prospero protocol. Without
- Xhis help, this program is impossible. As I wrote the program at the
- Xtime the protocol was being updated, I thank him for providing me all
- Xthe information when it came along. He also informed me of a test
- Xarchie server that I used to eliminate many bugs. I am grateful for all
- Xhis helps.
- X
- XTo the people in quiche.cs.mcgill.ca providing archie, it is certainly
- Xhard to imagine the days when archie was not available.
- X
- XTo all the people who sent me messages telling me the problems they
- Xencountered, telling me that the program worked on their machines,
- Xand telling me the program did not work on their machines, I thank you
- Xvery much. These people are:
- X
- XGary D. Kline, ssi!gdk@uunet.uu.net
- XEmmett Hogan, hogan@csl.sri.com
- XKarsten Thygesen, karthy@iesd.auc.dk
- XBrendan Kehoe, brendan@cs.widener.edu
- XPeter Mutsaiers, muts@fysak.fys.ruu.nl
- XKean Stump, kean@ucs.orst.edu # thanks for providing a Makefile
- XPeter Orbaek, poe@daimi.aau.dk # thanks for making it more perl'ish
- XBilly Barron, billy@sol.acs.unt.edu
- X
- XI may have missed one or two people. To them, I am sorry.
- X
- XI know the program is rather trivial and not even useful for many
- Xpeople. But I wrote in the hope that it might be useful for a few
- Xpeople. I posted it in the Usenet spirit of sharing.
- X
- XKhun Yee
- END_OF_FILE
- if test 1631 -ne `wc -c <'ACKNOWLEDGE'`; then
- echo shar: \"'ACKNOWLEDGE'\" unpacked with wrong size!
- fi
- # end of 'ACKNOWLEDGE'
- fi
- if test -f 'Makefile' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'Makefile'\"
- else
- echo shar: Extracting \"'Makefile'\" \(636 characters\)
- sed "s/^X//" >'Makefile' <<'END_OF_FILE'
- X# From kean@argh.ucs.orst.edu (Kean Stump) with the fixpath line
- X# added by me.
- X# Change the following two lines if you are not sysadmin.
- XOWNER=bin
- XGROUP=bin
- XLIB=resolver.pl archie.depend newgetopt.pl
- XBIN=archie
- XMAN=archie.l
- XSTARTUP=system.archierc
- XBINDIR=/usr/local/bin
- XLIBDIR=/usr/local/lib/perl
- XMANDIR=/usr/local/man/man1
- XSTARTUPDIR=/usr/local/lib
- X
- Xinstall:
- X perl fixpath $(BINDIR)/perl
- X install -o $(OWNER) -g $(GROUP) -m 755 $(BIN) $(BINDIR)
- X install -o $(OWNER) -g $(GROUP) -m 444 $(LIB) $(LIBDIR)
- X install -o $(OWNER) -g $(GROUP) -m 444 $(MAN) $(MANDIR)/archie.1
- X install -o $(OWNER) -g $(GROUP) -m 444 $(STARTUP) $(STARTUPDIR)
- END_OF_FILE
- if test 636 -ne `wc -c <'Makefile'`; then
- echo shar: \"'Makefile'\" unpacked with wrong size!
- fi
- # end of 'Makefile'
- fi
- if test -f 'fixpath' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'fixpath'\"
- else
- echo shar: Extracting \"'fixpath'\" \(297 characters\)
- sed "s/^X//" >'fixpath' <<'END_OF_FILE'
- X#!/u3/thesis/clipper/bin/perl
- Xeval "exec perl -S $0 $*"
- X if $running_under_some_shell;
- Xrename("archie", "archie.ori");
- Xopen(FILE, "archie.ori");
- Xopen(OUT, ">archie");
- Xprint OUT "\#\!$ARGV[0]\n";
- Xprint $_ unless (!($_ = <FILE>) || ($_ =~ /^\#\!/));
- Xwhile (<FILE>) {
- X print OUT $_;
- X}
- Xclose(OUT);
- END_OF_FILE
- if test 297 -ne `wc -c <'fixpath'`; then
- echo shar: \"'fixpath'\" unpacked with wrong size!
- fi
- chmod +x 'fixpath'
- # end of 'fixpath'
- fi
- if test -f 'archie.files' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'archie.files'\"
- else
- echo shar: Extracting \"'archie.files'\" \(1058 characters\)
- sed "s/^X//" >'archie.files' <<'END_OF_FILE'
- Xarchie.files -- this file.
- Xarchie -- the program file. Remember to set to executable
- XREADME -- the readme file for archie
- Xsocket.ph -- Yours might be called sys/socket.ph. If so,
- X change the name in the file archie.depend. This file is
- X included only for completeness's sake.
- Xresolver.pl -- a simple address resolver in perl. archie uses
- X gethostbyname() first before trying the
- X resolver. Do check the domain server name in the
- X resolver file.
- Xnewgetopt.pl -- I got this from comp.lang.perl. A wonderful package.
- Xarchie.depend -- System dependent stuff.
- Xarchie.l -- A rudimentary manual page for archie.
- XDOT.archierc -- An example .archirc file.
- Xarchie.examples -- Some examples on using archie.
- Xfixpath -- To fix the perl binary directory in archie.
- XMakefile -- A simple install script for archie.
- Xsystem.archierc -- A sample system archierc
- X
- XThanks.
- END_OF_FILE
- if test 1058 -ne `wc -c <'archie.files'`; then
- echo shar: \"'archie.files'\" unpacked with wrong size!
- fi
- # end of 'archie.files'
- fi
- if test -f 'archie' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'archie'\"
- else
- echo shar: Extracting \"'archie'\" \(18760 characters\)
- sed "s/^X//" >'archie' <<'END_OF_FILE'
- X#!/u3/thesis/clipper/bin/perl
- X# Copyright (C) Khun Yee Fung clipper@csd.uwo.ca 1991
- X#
- X# Modified by Peter Orbaek (poe@daimi.aau.dk) to look more perl'ish.
- X#
- X# You can do anything to this program except selling it for profit or
- X# pretending you wrote it. The copyright notice must be preserved in all
- X# copies. Absolutely no warranty.
- X#
- X# $Id: archie,v 3.8 1991/08/12 17:05:18 clipper Exp clipper $
- X#
- X# This version of the program is based on Beta 4.2 of prospero protocol.
- X# The Version number of this release is $Revision: 3.8 $.
- X
- Xeval "exec perl -S $0 $*"
- X if $running_under_some_shell;
- X
- Xrequire 'resolver.pl';
- Xrequire 'sys/socket.ph';
- Xrequire 'newgetopt.pl';
- Xrequire 'archie.depend';
- X$servername =~ tr/A-Z/a-z/;
- X
- Xselect(STDOUT); $| = 1;
- X
- X# To get the options on the command line. Explanations are in the code
- X# handling them.
- X&NGetOpt('match=i', 'reg', 'exact', 'nocase', 'case', 'server=s',
- X 'ffile=s', 'format=s', 'along', 'norc', 'syntax', 'version',
- X 'sort=s', 'reverse', 'rc=s', 'domain=s', 'aftp');
- X
- X# Get the name of this program. The last element is the one.
- X@prog = split('/', $0);
- X$prog = $prog[$#prog];
- X
- X# Usage string.
- X# The options -syntax and -aftp are invisible because -syntax is used only
- X# to check the syntax of the program and -aftp is useful only for the archie
- X# interface of the nftp program.
- X$usage =
- X"Usage: $prog [options] word1 word2 ...
- X Where options are one or more of the following:
- X -along Print the entries when they are available.
- X -case Case sensitive
- X -nocase Case insensitive
- X -exact Exact match
- X -reg Regular expression match
- X -match \# Max hits
- X -server hostname An alternative archie server
- X -ffile filename Use a format file
- X -format string Specify a format string
- X -norc Do not read .archierc file in home directory.
- X -version Print the version number of the program.
- X -rc filename Read another file as the startup file.
- X -sort [date|host] Sort by date ot host.
- X -reverse Reverse sorting order.
- X -domain string Use the order in the string to sort the hosts.
- X";
- X
- X($Revision) = ('$Revision: 3.8 $' =~ /Revision: ([\d\.]+)/);
- X$version = "Prospero Beta.4.2 (Perl Archie Client Version $Revision)\n";
- X
- X# Should have at least one query.
- Xif ($#ARGV < 0) {
- X if (defined($opt_version)) {
- X print $version;
- X exit(0);
- X }
- X print "Please specify at least one query.\n";
- X print $usage;
- X exit(255);
- X}
- X@string = @ARGV;
- X
- X%domainorder = ('ca', 1, 'edu', 2, 'com', 3, 'gov', 4, 'net', 5,
- X 'de', 6, 'dk', 7, 'nl', 8, 'fi', 9, 'se', 10,
- X 'au', 1000, 'nz', 1001);
- X
- X# For the conversion of date in the subroutine date.
- X%month = ('Jan', 1, 'Feb', 2, 'Mar', 3, 'Apr', 4, 'May', 5, 'Jun', 6,
- X 'Jul', 7, 'Aug', 8, 'Sep', 9, 'Oct', 10, 'Nov', 11, 'Dec', 12);
- X@month = ('', 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
- X 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
- X
- X# The archie port number is 1525.
- X$port = 1525;
- X
- X# The socketaddr structure. See /usr/include/sys/socket.h for the C
- X# version.
- X$sockaddr = 'S n a4 x8';
- X
- X# Defaults: maximum hit is 40. It does not mean there will be exactly
- X# 40 entries returned, though. Expect a few entries more or less.
- X# The default search option is case insensitive.
- X$match = 40; $case = 'S'; $pnum = 1;
- X
- X# The default format string. Can be overiden by the -format or -ffile
- X# options. Can also specify a default format string in ~/.archierc
- X$format = "%02seq Host %host
- X
- X Location: %dir
- X %10type %mode %08size %date %name
- X
- X";
- X
- X# To get the user name and user home path.
- X@pw = getpwuid($<);
- X$user = $pw[0];
- X$userpath = $pw[7];
- X
- X# Read the system startup file if there is one. Set the filename in
- X# archie.depend.
- X
- X&parserc($startup);
- X
- X$startfile = defined($opt_rc) ? $opt_rc : "$userpath/.archierc";
- X$along = defined($opt_along);
- X&parserc($startfile) unless (defined($opt_norc)); # Read ~/.archierc?
- X$match = $opt_match if (defined($opt_match)); # how many hits wanted?
- Xprint $version if (defined($opt_version)); # Print version number?
- X&pdomain($opt_domain) if (defined($opt_domain)); # Get a domain order?
- X
- X# The sort option. Default is by the domains of the hosts.
- X$sortpack = 'host';
- Xif ($opt_sort) {
- X if ($opt_sort eq 'date') {
- X $sortpack = 'date';
- X }
- X elsif ($opt_sort eq 'host') {
- X $sortpack = 'host';
- X }
- X else {
- X print "Not valid sort field: $opt_sort. Assume host.\n";
- X $sortpack = 'host';
- X }
- X}
- X$reversesort = defined($opt_reverse);
- X
- X# Read a format string from a file.
- Xif (defined($opt_ffile)) {
- X open(FFILE, "$opt_ffile") || die "Can't open format file $opt_ffile\n";
- X # slurp in the whole file
- X undef $/; $format = <FFILE>; $/ = "\n";
- X close FFILE;
- X}
- X
- X# Read a format string on the command line.
- X$format = $opt_format if (defined($opt_format));
- X
- X# Set the search option.
- X$case = $ecase = '=' if (defined($opt_exact)); # Exact match
- X$case = 'C' if (defined($opt_case)); # Set search option to case sensitive.
- X$case = 'S' if (defined($opt_nocase)); # Set search option to case insensitive.
- X$case = 'R' if (defined($opt_reg)); # search using a regular expression.
- X$case =~ tr/A-Z/a-z/ if ($ecase eq '=');
- X
- X# set a new archie server.
- Xif (defined($opt_server)) {
- X $serverip = $servername = $opt_server;
- X $servername =~ tr/A-Z/a-z/;
- X}
- X
- X# Support for a aftp pipe. [Useful only for the program nftp.]
- X$format = "%type:%host:%dir\n" if ($opt_aftp);
- X
- X# parse the format string,
- X$format = &parseformat($format);
- X
- X# This is for checking the format etc. Not for external use :-)
- Xif ($opt_syntax) {
- X print "Execution until here.\n";
- X exit(0);
- X}
- X
- X# Get the IP address of the archie server.
- Xif ($serverip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
- X $thataddr = pack("CCCC", $1, $2, $3, $4);
- X $serverip = $servername;
- X}
- Xelsif (!(($name, $aliases, $type, $len, $thataddr) =
- X gethostbyname($servername))) {
- X $thataddr = &resolver($servername, $nsserver) ||
- X die "Can't find the IP address of the archie server $servername\n";
- X $serverip = join('.', unpack("CCCC", $thataddr));
- X}
- Xelse {
- X $serverip = join('.', unpack("CCCC", $thataddr));
- X}
- X
- X$them = pack($sockaddr, &AF_INET, $port, $thataddr);
- X
- X# now construct our own address
- X# dnb@meshugge.media.mit.edu gave the patch to satisfy taintperl.
- X$PATH = $ENV{'PATH'};
- X$ENV{'PATH'} = '/bin:/usr/bin';
- Xchop($thishost = `hostname`);
- X$ENV{'PATH'} = $PATH;
- X($name, $aliases, $type, $len, $thisaddr) = gethostbyname($thishost);
- X$us = pack($sockaddr, &AF_INET, 0, $thisaddr);
- X
- X# get and bind a socket.
- Xsocket(DATA, &AF_INET, &SOCK_DGRAM, 0) || die "socket:$!\n";
- Xbind(DATA, $us) || die "bind: $!\n";
- X
- X# Get the list of matches.
- X@lists = &list($them, $user, $match, @string);
- X
- X# Print them.
- X&result(@lists) unless ($along);
- X
- Xclose(DATA);
- X
- Xsub getpacket {
- X local($restime) = @_;
- X local($seq, $rin, $timeleft, $rout, $ans, $id, $hbyte, $rdp, $hdr_len);
- X local($header, $backoff, $kk, $dum, $flags, $wantack, $pktsnum, $nfound);
- X $seq = 0;
- X
- X # wait for a packet to come back.
- X $rin = '';
- X vec($rin, fileno(DATA), 1) = 1;
- X ($nfound, $timeleft) = select($rout = $rin, '', '', $restime);
- X if ($timeleft == 0 || ord($rout) == 0){
- X return(0);
- X }
- X
- X # Read a packet from the server.
- X $ans = '';
- X recv(DATA, $ans, 10000, 0) || die "recv: Can't recv. Die.\n";
- X
- X $hbyte = ord(substr($ans, 0, 1));
- X $header = '';
- X if ($hbyte < 20) {
- X $rdp = ($hbyte & 0xc0) >> 6;
- X $hdr_len = $hbyte & 0x3F;
- X $header = substr($ans, 0, $hdr_len);
- X substr($ans, 0, $hdr_len) = '';
- X $backoff = $seq = $kk = $flags = 0;
- X ($dum, $id, $seq, $kk, $dum, $backoff, $flags) =
- X unpack("Cnnnnnn", $header);
- X # Should I acknowledge?
- X $wantack = (($flags & 0x8000) != 0);
- X $pktsnum = ($kk) ? $kk : 0;
- X $timeout = $backoff if ($backoff);
- X }
- X else {
- X $seq = 1;
- X $pktsnum = 1;
- X $wantack = 0;
- X $timeout = 0;
- X }
- X return (1, $seq, $wantack, $pktsnum, $timeout, $ans);
- X}
- X
- X# The subroutine list is the `meat' of the query.
- X# It sends the query to the archie server host and parses the entries
- X# returned by the server.
- Xsub list {
- X local($them, $user, $match, @words) = @_;
- X local($ans, $timeout, $retries, $lines, @lines);
- X local($pktsnum, $pktseq, $seq, $timeleft, $acktime);
- X local($dum, $backoff, $word, $index, @received, $recthrough);
- X local($sq, $waxk, $pkts, $tout);
- X
- X $timeout = 4;
- X $retries = 3;
- X $acktime = 0.3;
- X @received = ('YES');
- X
- X # Construct the query packet.
- X @lines = ("VERSION 1\n", "AUTHENTICATOR UNAUTHENTICATED $user\n");
- X foreach $word (@words) {
- X push(@lines, "DIRECTORY ASCII ARCHIE/MATCH($match,0,$case)/$word\n");
- X push(@lines, "LIST ATTRIBUTES COMPONENTS \n");
- X }
- X $lines = join('', @lines);
- X
- X $recthrough = 0;
- X
- X RETRY:
- X {
- X $head = pack("Cnnnn", 9, $$, 1, 1, $recthrough);
- X send(DATA, $head . $lines, 0, $them)
- X || die "send: Failed to send packet: $!";
- X
- X $pktsnum = 0;
- X while ($pktsnum == 0 || $pktseq < $pktsnum) {
- X $restime = $timeout;
- X ($res, $sq, $wack, $pkts, $tout, $ans) = &getpacket($restime);
- X if (!$res){
- X if ($retries-- > 0) {
- X $timeout *= 2;
- X redo RETRY;
- X }
- X else {
- X die "No responses from the archie server.\n";
- X }
- X }
- X do {
- X $seq = $sq;
- X $timeout = $tout if ($tout);
- X $pktsnum = $pkts if ($pkts);
- X $wantack++ if ($wack);
- X if ($seq) {
- X if ($received[$seq] ne 'YES') {
- X # not duplicate packet.
- X $retries = 3;
- X foreach $i (($#received + 1) .. ($seq - 1)) {
- X $received[$i] = "NO $i";
- X }
- X $received[$seq] = 'YES';
- X $ans =~ s/\000//g;
- X $answer[$seq] = $ans unless ($recthrough >= $seq);
- X @notyet = grep(/^NO/, @received);
- X if ($#notyet < 0) {
- X $recthrough = $#received;
- X $pktseq = $#received;
- X }
- X else {
- X $notyet[0] =~ /NO (\d+)$/;
- X $recthrough = $1 - 1;
- X $pktseq = $1 - 1;
- X }
- X if ($along) {
- X &alongtheway($recthrough, 0);
- X }
- X }
- X if ($pktsnum == 0 || $pktseq < $pktsnum) {
- X ($res, $sq, $wack, $pkts, $tout, $ans) =
- X &getpacket($acktime);
- X }
- X else {
- X $head = pack("Cnnnn", 9, $$, 1, 1, $recthrough);
- X last;
- X }
- X }
- X } until (!$res || $seq == 0);
- X $head = pack("Cnnnn", 9, $$, 1, 1, $recthrough);
- X if ($wantack) {
- X send(DATA, $head . $lines, 0, $them)
- X || die "send: Failed to send an acknowledgement: $!";
- X $wantack = 0;
- X }
- X }
- X }
- X if ($wantack) {
- X send(DATA, $head . $lines, 0, $them)
- X || die "send: Failed to send an acknowledgement: $!";
- X }
- X if ($along) {
- X &alongtheway($recthrough, 1);
- X }
- X @answer;
- X}
- X
- X# Print the entries in a packet.
- Xsub parselist {
- X local(@lists) = @_;
- X local(@lines, $dum, $lastmod, $modes, $size, $dir, $entry);
- X local($name, @attr, @ainfo, $type);
- X
- X $entry = 0;
- X # split the lines in the packet first.
- X @lines = split(/\n/, join('', @lists));
- X foreach $line (@lines) {
- X # If a LINK L line, then get the initial fields for the
- X # entry. Output the last entry if there is one.
- X if ($line =~ /^LINK L/) {
- X &store($host, $type, $dir, $size, $modes, $lastmod, $name)
- X if ($entry);
- X $type = $name = $host = $dir = '';
- X $size = $modes = $lastmod = '';
- X $#attr = $#ainfo = -1;
- X ($dum, $dum, $type, $name, $dum, $host, $dum, $dir, $dum, $dum) =
- X split(/ /, $line);
- X $host =~ tr/A-Z/a-z/;
- X $entry = 1;
- X }
- X elsif ($line =~ /^LINK /) {
- X # What should I do if the response is LINK but not L?
- X }
- X elsif ($line =~ /^LINK-INFO/) {
- X # A LINK-INFO line. Get one attribute per line.
- X ($dum, $dum, $attr, $dum, @info) = split(/ /, $line);
- X if ($attr eq 'SIZE') {
- X $size = join(' ', @info);
- X }
- X elsif ($attr eq 'UNIX-MODES') {
- X $modes = join(' ', @info);
- X }
- X elsif ($attr eq 'LAST-MODIFIED') {
- X $lastmod = join(' ', @info);
- X }
- X else {
- X push(@attr, $attr);
- X push(@ainfo, join(' ', @info));
- X }
- X }
- X elsif ($line =~ /^VERSION-NOT-SUPPORTED TRY (\d+)-(\d+),(\d+)/) {
- X die "Version of archie server ($1-$2, $3) not supported.\n";
- X }
- X elsif ($line =~ /^NOT-A-DIRECTORY/) {
- X print "Archie error: Not a directory.\n";
- X }
- X elsif ($line =~ /^UNRESOLVED/) {
- X print "Archie error: Unresolved entries.\n";
- X }
- X elsif ($line =~ /^FILTER/) {
- X }
- X elsif ($line =~ /^OBJECT-INFO/) {
- X }
- X elsif ($line =~ /^NONE-FOUND/) {
- X }
- X elsif ($line =~ /^SUCCESS/) {
- X }
- X elsif ($line =~ /^FORWARDED/) {
- X print "Archie error: No forwarding allowed.\n";
- X }
- X elsif ($line =~ /^FAILURE/) {
- X print "Archie server returns error. \n";
- X if ($line =~ /^FAILURE NOT-AUTHORIZED/) {
- X print "Probably Max. hit too high. Use smaller -match value\n";
- X }
- X else {
- X print "The error message is:\n";
- X print $line;
- X }
- X }
- X elsif ($line =~ /^NOT-AUTHORIZED/) {
- X print "Archie error: Not authorized.\n";
- X }
- X else {
- X }
- X }
- X &store($host, $type, $dir, $size, $modes, $lastmod, $name) if ($entry);
- X}
- X
- X# Write the fields out on terminal using the format string.
- Xsub write {
- X local($host, $type, $dir, $size, $mode, $lastmod, $name) = @_;
- X local($seq, @path, $date, $path);
- X
- X # Convert the date string from 19910713123250Z to
- X # 1991 Jul 13 12:32:50 GMT
- X $date = ($lastmod eq '') ? 'No Date' : &date($lastmod);
- X $seq = $pnum++;
- X
- X # print the entry. Die if something is wrong. Should I
- X # Log the output in a file so the effect is not wasted?
- X eval "printf $format"
- X || die "A syntax error occured when printing the format string: $@\n";
- X}
- X
- X# Convert a string.
- Xsub date {
- X local($date) = @_;
- X local($year, $month, $day, $hour, $min, $sec) =
- X (0, 1, 0, 0, 0, 0);
- X local($zone) = 'Z';
- X
- X ($year, $month, $day, $hour, $min, $sec, $zone) =
- X ($date =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(.*)/);
- X
- X # A time zone Z is the same as GMT.
- X if ($zone eq 'Z') {
- X $zone = 'GMT';
- X }
- X "$year $month[$month] $day $hour:$min:$sec $zone";
- X}
- X
- X# Parse the format string to convert it to a valid perl format
- X# string.
- Xsub parseformat {
- X local($string) = @_;
- X local($nstring, $index, @plist);
- X
- X $string =~ s/([\$\{\}\@\*])/\\$1/g;
- X $nstring = '';
- X $#plist = -1;
- X while (($index = index($string, '%')) >= 0) {
- X $nstring .= substr($string, 0, $index);
- X substr($string, 0, $index) = '';
- X if (substr($string, 1, 1) eq '%') {
- X substr($string, 0, 2) = '';
- X $nstring .= '%%';
- X }
- X elsif ($string =~ /^\%(\d*)(host|dir|mode|date|seq|size|name|type)/) {
- X push(@plist, "\$$2");
- X if ($2 eq 'size' || $2 eq 'seq') {
- X $nstring .= "\%$1d";
- X }
- X else {
- X $nstring .= "\%$1s";
- X }
- X substr($string, 0, length($1 . $2) + 1) = '';
- X }
- X else {
- X die sprintf("$prog: Format error. Unknown field: %s\n", $string);
- X }
- X }
- X $nstring .= $string;
- X $nstring = '"' . $nstring . '"';
- X join(', ', $nstring, @plist);
- X}
- X
- X# Parse the startup file ~/.archierc
- X# The format of the file is very simple:
- X# command option
- X# The format command must be the last one.
- Xsub parserc {
- X local($startfile) = @_;
- X local($domain, @domain);
- X if (-e $startfile && -r $startfile) {
- X open (RC, $startfile) || return;
- X while (<RC>) {
- X chop;
- X if (/^\s*match\s+(\d+)\s*$/) {
- X $match = $1;
- X }
- X elsif (/^\s*sort\s+/) {
- X if (/^\s*sort\s+date\s*$/) {
- X $sortpack = 'date';
- X }
- X elsif (/^\s*sort\s+host\s*$/) {
- X $sortpack = 'host';
- X }
- X else {
- X print "Unknown sort field in startup file: $startfile\n";
- X }
- X }
- X elsif (/^\s*domain\s+(.*)$/) {
- X &pdomain($1);
- X }
- X elsif (/^\s*search\s+([a-z]+)\s*$/) {
- X if ($1 eq 'case') {
- X $case = 'C';
- X }
- X elsif ($1 eq 'nocase') {
- X $case = 'S';
- X }
- X elsif ($1 eq 'reg') {
- X $case = 'R';
- X }
- X elsif ($1 eq 'exact') {
- X $case = '=';
- X }
- X else {
- X print "$prog: $user/.archierc: unknown search option $1\n";
- X }
- X }
- X elsif (/^\s*host\s+(.+)\s*$/) {
- X $archieserver = $1;
- X }
- X elsif (/^\s*format\s*$/) {
- X undef $/; $format = <RC>; $/ = "\n";
- X last;
- X }
- X elsif ($_ =~ /^\s*$/ || $_ =~ /^\s*\#/) {
- X # Empty or comment line in the startup file.
- X }
- X else {
- X print "$prog: Unknown option in $user/.archierc: $_\n";
- X }
- X }
- X close(RC);
- X }
- X}
- X
- Xsub store {
- X local($host, $type, $dir, $size, $mode, $lastmod, $name) = @_;
- X
- X $type = ($type eq 'DIRECTORY') ? 'Directory' : 'File';
- X if ($type eq 'Directory' && $dir =~ m.ARCHIE/HOST.) {
- X ($archie, $dum, $host, $dir) =
- X ($dir =~ m|([^/]+)/([^/]+)/([^/]+)/(.*)$|);
- X $dir = '/' . $dir;
- X }
- X push(@s_lastmod, $lastmod);
- X push(@s_name, $name);
- X push(@s_host, $host);
- X push(@s_type, $type);
- X push(@s_dir, $dir);
- X push(@s_size, $size);
- X push(@s_mode, $mode);
- X}
- X
- Xsub result {
- X local(@lists) = @_;
- X local(%entries, $host, $index, @order, @host, $order, $field);
- X $#s_lastmod = -1;
- X $#s_name = -1;
- X $#s_host = -1;
- X $#s_type = -1;
- X $#s_dir = -1;
- X $#s_mode = -1;
- X $#s_size = -1;
- X &parselist(@lists);
- X $index = 0;
- X %entries = ();
- X @field = ($sortpack eq 'date') ? @s_lastmod : @s_host;
- X foreach $field (@field) {
- X $entries{$field} .= "$index ";
- X $index++;
- X }
- X @order = ($sortpack eq 'date') ? sort sortdate @s_lastmod :
- X sort sorthost @s_host;
- X foreach $order (@order) {
- X if ($entries{$order} ne '') {
- X @indexes = split(' ', $entries{$order});
- X foreach $i (@indexes) {
- X &write($s_host[$i], $s_type[$i], $s_dir[$i],
- X $s_size[$i], $s_mode[$i], $s_lastmod[$i], $s_name[$i]);
- X }
- X $entries{$order} = '';
- X }
- X }
- X}
- X
- Xsub sorthost {
- X local($t);
- X local($c, $d);
- X @c = split(/\./, $a);
- X @d = split(/\./, $b);
- X $domainorder{$c[$#c]} = 1100 if ($domainorder{$c[$#c]} eq '');
- X $domainorder{$d[$#d]} = 1100 if ($domainorder{$d[$#d]} eq '');
- X $t = ($domainorder{$c[$#c]} > $domainorder{$d[$#d]}) ? 1 :
- X ($domainorder{$c[$#c]} < $domainorder{$d[$#d]}) ? -1 : 0;
- X ($reversesort) ? -$t : $t;
- X}
- X
- Xsub sortdate {
- X local($t);
- X local(@c, @d, $c, $d, $e, $f);
- X $c = $a; $d = $b;
- X @c = split(/ /, $c);
- X @d = split(/ /, $d);
- X $e = join(' ', $c[0], "$month{$c[1]}", @c[2 .. 6]);
- X $f = join(' ', $d[0], "$month{$d[1]}", @d[2 .. 6]);
- X $t = $e gt $f ? 1 : $e lt $f ? -1 : 0;
- X ($reversesort) ? -$t : $t;
- X}
- X
- Xsub pdomain {
- X local($list) = @_;
- X local($domain, @domain, $index);
- X @domain = split(/ /, $list);
- X $index = 0;
- X foreach $domain (@domain) {
- X $domainorder{$domain} = $index;
- X $index++;
- X }
- X}
- X
- Xsub alongtheway {
- X local($through, $all) = @_;
- X return if ($queuehead > $through);
- X local(@link, @part, @part1);
- X @part = split(/\n/, join('', @answer[$queuehead .. $through]));
- X if (!$all) {
- X while(($line = pop(@part)) !~ /^LINK L/) {
- X unshift(@part1, $line);
- X }
- X unshift(@part1, $line) unless ($line eq '');
- X $answer[$through] = join("\n", @part1);
- X $answer[$through] .= "\n";
- X $queuehead = $through;
- X }
- X &result(join("\n", @part));
- X}
- END_OF_FILE
- if test 18760 -ne `wc -c <'archie'`; then
- echo shar: \"'archie'\" unpacked with wrong size!
- fi
- chmod +x 'archie'
- # end of 'archie'
- fi
- if test -f 'archie.l' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'archie.l'\"
- else
- echo shar: Extracting \"'archie.l'\" \(7023 characters\)
- sed "s/^X//" >'archie.l' <<'END_OF_FILE'
- X.\" $Id: archie.l,v 3.6 1991/08/03 00:16:30 clipper Exp clipper $
- X.TH ARCHIE L "28 JULY 1991"
- X
- X.SH NAME
- Xarchie \- query an archie server
- X
- X.SH SYNOPSIS
- X.B archie
- X.RB [ " \-match hits " ]
- X.RB [ " \-reg " ]
- X.RB [ " \-exact " ]
- X.RB [ " \-nocase " ]
- X.RB [ " \-case " ]
- X.RB [ " \-server hostname " ]
- X.RB [ " \-ffile formatfile " ]
- X.RB [ " \-format format " ]
- X.RB [ " \-norc " ]
- X.RB [ " \-rc" ]
- X.RB [ " \-sort date \| host " ]
- X.RB [ " \-reverse " ]
- X.RB [ " \-version " ]
- X.RB [ " \-domain string " ]
- X.RB [ " \-along " ]
- X.IR word1
- X.IR word2 \&.\|.\|.
- X.LP
- X
- X.SH DESCRIPTION
- X.B archie
- Xarchie queries a remote database to identify files and directories
- Xwith the words 'world1', 'word2', etc, in their names. The program
- Xallows the user to specify a format to print the matching entries.
- X.LP
- Xarchie is a database that assists users in identify the sites that
- Xhave files matching the given words. For example, if you want to find
- Xout the anonymous sites carrying the file 'wonder', a query to the
- Xarchie database will return a list of the hosts with files whose names
- Xinclude that string. The directory and file name are also returned so
- Xthat the user can subsequently retrieve the file.
- X
- X.LP
- X.SH NOTE
- X
- XPlease set the maximum hit number to a moderate number. The archie
- Xserver you are accessing is used by many people. Setting the maximum
- Xhit number to a very high number in peak periods not only lengthen the
- Xtime you have to wait for the response, it also lengthens the time
- Xother people have to wait too. Please also refrain from having a large
- Xnumber of queries in peak periods for the same reason.
- X
- X.LP
- X.SH OPTIONS
- X
- XYou must have all the options listed before the words you want to
- Xmatch. Otherwise, the options after the first word will be treated as
- Xadditional words. For example, `archie word -reg' queries two words,
- X`word' and `-reg'.
- X
- X.TP
- X.B \-match hits
- XSet the maximum number of hits to be ` hits '. The default number is
- X40. Please set this to a moderate number.
- X.TP
- X.B \-case
- XSet the search option to be case sensitive.
- X.TP
- X.B \-nocase
- XSet the search option to be case insensitive.
- X.TP
- X.B \-exact
- XSet the search option to be exact.
- X.TP
- X.B \-reg
- XSet the search option to be regular expression.
- X.TP
- X.B \-along
- XPrints the entries along the way. The default is to print the entries
- Xafter all of them have been obtained. If the connection dies in the
- Xmiddle of the query, you will have the partial list up to that time.
- X.TP
- X.B \-server hostname
- XSet the archie server to ` hostname '.
- X.TP
- X.B \-ffile filename
- XRead the file ` filename ' to get the format string.
- X.TP
- X.B \-format string
- XSet the format string to be ` string '. For example, \-format '%host:%dir:%size:%date\\n'.
- XNotice the single quotes will prevent the shell from interpreting the string.
- X.TP
- X.B \-norc
- XDo not read the .archierc file from the user's home directory.
- X.TP
- X.B \-rc filename
- XUse filename as the startup file instead.
- X.TP
- X.B \-sort [host | date]
- XSort by the host or date. To sort by host, the sort key is the domain
- Xof the hosts. This is useful for sorting the entries by the distance
- Xof the hosts to your own machine.
- X.TP
- X.B \-reverse
- XTo reverse the sorting order.
- X.TP
- X.B \-version
- XTo print out the version number of the program.
- X.TP
- X.B \-domain string
- XIf the sorting is done using the hosts, use the order specify by
- X`string' to order the hosts. For example, if `string' is 'nl de fi fr
- Xedu ca', then the hosts in nl domain will be first; the hosts in the
- Xde domain will be printed second, etc.
- X
- X.LP
- X.SH STARTUP FILE
- X.I Archie
- Xreads the file ` .archierc ' from the user's home directory. The
- Xcommands allowed are ` match ', ` search ', ` host ', ` domain ' and `
- Xformat '. The format command must be specified last in the file.
- XEach line has two fields; the first field is the name of the command
- Xand the second field is the option value. The value of the ` match '
- Xoption is an integer. The values allowed for the ` search ' command
- Xare
- X.I case, nocase, reg, exact
- Xwith the same meaning as on the command line. The ` host ' command
- Xallows an alternate archie server to be specified. The file can have
- Xcomment lines before the format option. Each comment line must appear
- Xon a separate line. The `domain' field is used to specify the order
- Xof hosts to be printed. This is useful to specify the nearest hosts
- Xfirst and farthest hosts at the end. No comments are allowed on the
- Xsame lines as the commands. A comment line is started with the \#
- Xcharacter.
- X
- X.LP
- X.SH OUTPUT FORMAT
- XThe output of
- X.I archie
- Xis controled by a format string. This format string can be changed in
- Xthe archie startup file, specified on the command line, or read from a
- Xfile. The format string has a similar syntax with the format file of
- Xprintf(). The escape character for fields is %. The meaning of
- Xbackslash is similar to that in printf. The allowed fields are:
- X
- X.PD 0
- X.TP 10
- X.B %
- XDouble % will produce a single % in the output.
- X.TP
- X.B host
- XThis field will be replaced by the host name in an entry.
- X.TP
- X.B dir
- XThis field specifies the path of the entry.
- X.TP
- X.B mode
- XThe protection of the entry.
- X.TP
- X.B date
- XThe date of last modification of the entry.
- X.TP
- X.B seq
- XThe number of entries processed so far.
- X.TP
- X.B size
- XThe size of the entry.
- X.TP
- X.B name
- XThe filename of entry.
- X.TP
- X.B type
- XThe file type of the entry, a directory or a file.
- X
- X.LP
- XAfter the % character and before the field string, a optional number
- Xis allowed to specify the width of the field possibly zero-padded. For
- Xexample, '%04seq' means zero-padded 4-character width field for the
- Xsequence number.
- X
- X.LP
- X.SH SEE ALSO
- X.BR telnet(1)
- X.BR ftp (1)
- X
- X.LP
- X.SH BUGS
- X.LP
- XThis program is under revision. Probably has quite a few bugs.
- X
- X.LP
- X.SH DIAGNOSTICS
- X.TP
- X.BI "archie: Format string ignored: a format file was specified"
- XA format string was specified after a format file was given.
- X.TP
- X.BI "archie: Format error. Unknown field: " string
- X.I String
- Xis not recognized.
- X.TP
- X.BI "archie: " user "/.archierc: unknown search option " option
- XThe match option
- X.I option
- Xin
- X.I user
- X/.archierc is not known.
- X.TP
- X.BI "archie: Unknown option in " user "/.archierc: " option
- XThe option in
- X.I user
- Xarchie startup file is not known.
- X
- X.LP
- X.SH AUTHOR
- XKhun Yee Fung (clipper@csd.uwo.ca). Department of Computer Science,
- XUniversity of Western Ontario.
- X
- X.LP
- X.SH AUTHOR OF PROSPERO
- XThe Archie client queries a remote database using the Prospero
- Xprotocol. Clifford Neuman (bcn@isi.edu) designed the Prospero
- Xprotocol and wrote the server.
- X
- X
- X.LP
- X.SH THE ARCHIE GROUP
- XThe Prospero server queries the Archie database and returns the
- Xresults. It is the Archie database that is responding to your query.
- XThe archie database is written and maintained by Allan Emtage
- X(bajan\@cs.mcgill.ca) and Bill Heelan (wheelan\@cs.mcgill.ca). Peter
- XDeutsch (peterd\@cs.mcgill.ca) is also involved in the archie group in
- XMcGill.
- X
- X.LP
- X.SH COPYRIGHT
- XYou can modify, distribute, and generally do anything you want to this
- Xfile except to sell it for profit. You must preserve the copyright
- Xnotice in all copies of this program.
- X
- XABSOLUTELY NO WARRANTY.
- END_OF_FILE
- if test 7023 -ne `wc -c <'archie.l'`; then
- echo shar: \"'archie.l'\" unpacked with wrong size!
- fi
- # end of 'archie.l'
- fi
- if test -f 'socket.ph' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'socket.ph'\"
- else
- echo shar: Extracting \"'socket.ph'\" \(2752 characters\)
- sed "s/^X//" >'socket.ph' <<'END_OF_FILE'
- Xif (!defined &_sys_socket_h) {
- X eval 'sub _sys_socket_h {1;}';
- X eval 'sub SOCK_STREAM {1;}';
- X eval 'sub SOCK_DGRAM {2;}';
- X eval 'sub SOCK_RAW {3;}';
- X eval 'sub SOCK_RDM {4;}';
- X eval 'sub SOCK_SEQPACKET {5;}';
- X eval 'sub SO_DEBUG {0x0001;}';
- X eval 'sub SO_ACCEPTCONN {0x0002;}';
- X eval 'sub SO_REUSEADDR {0x0004;}';
- X eval 'sub SO_KEEPALIVE {0x0008;}';
- X eval 'sub SO_DONTROUTE {0x0010;}';
- X eval 'sub SO_BROADCAST {0x0020;}';
- X eval 'sub SO_USELOOPBACK {0x0040;}';
- X eval 'sub SO_LINGER {0x0080;}';
- X eval 'sub SO_OOBINLINE {0x0100;}';
- X eval 'sub SO_DONTLINGER {(~ &SO_LINGER);}';
- X eval 'sub SO_SNDBUF {0x1001;}';
- X eval 'sub SO_RCVBUF {0x1002;}';
- X eval 'sub SO_SNDLOWAT {0x1003;}';
- X eval 'sub SO_RCVLOWAT {0x1004;}';
- X eval 'sub SO_SNDTIMEO {0x1005;}';
- X eval 'sub SO_RCVTIMEO {0x1006;}';
- X eval 'sub SO_ERROR {0x1007;}';
- X eval 'sub SO_TYPE {0x1008;}';
- X eval 'sub SOL_SOCKET {0xffff;}';
- X eval 'sub AF_UNSPEC {0;}';
- X eval 'sub AF_UNIX {1;}';
- X eval 'sub AF_INET {2;}';
- X eval 'sub AF_IMPLINK {3;}';
- X eval 'sub AF_PUP {4;}';
- X eval 'sub AF_CHAOS {5;}';
- X eval 'sub AF_NS {6;}';
- X eval 'sub AF_NBS {7;}';
- X eval 'sub AF_ECMA {8;}';
- X eval 'sub AF_DATAKIT {9;}';
- X eval 'sub AF_CCITT {10;}';
- X eval 'sub AF_SNA {11;}';
- X eval 'sub AF_DECnet {12;}';
- X eval 'sub AF_DLI {13;}';
- X eval 'sub AF_LAT {14;}';
- X eval 'sub AF_HYLINK {15;}';
- X eval 'sub AF_APPLETALK {16;}';
- X eval 'sub AF_NIT {17;}';
- X eval 'sub AF_802 {18;}';
- X eval 'sub AF_OSI {19;}';
- X eval 'sub AF_X25 {20;}';
- X eval 'sub AF_OSINET {21;}';
- X eval 'sub AF_GOSIP {22;}';
- X eval 'sub AF_MAX {21;}';
- X eval 'sub PF_UNSPEC { &AF_UNSPEC;}';
- X eval 'sub PF_UNIX { &AF_UNIX;}';
- X eval 'sub PF_INET { &AF_INET;}';
- X eval 'sub PF_IMPLINK { &AF_IMPLINK;}';
- X eval 'sub PF_PUP { &AF_PUP;}';
- X eval 'sub PF_CHAOS { &AF_CHAOS;}';
- X eval 'sub PF_NS { &AF_NS;}';
- X eval 'sub PF_NBS { &AF_NBS;}';
- X eval 'sub PF_ECMA { &AF_ECMA;}';
- X eval 'sub PF_DATAKIT { &AF_DATAKIT;}';
- X eval 'sub PF_CCITT { &AF_CCITT;}';
- X eval 'sub PF_SNA { &AF_SNA;}';
- X eval 'sub PF_DECnet { &AF_DECnet;}';
- X eval 'sub PF_DLI { &AF_DLI;}';
- X eval 'sub PF_LAT { &AF_LAT;}';
- X eval 'sub PF_HYLINK { &AF_HYLINK;}';
- X eval 'sub PF_APPLETALK { &AF_APPLETALK;}';
- X eval 'sub PF_NIT { &AF_NIT;}';
- X eval 'sub PF_802 { &AF_802;}';
- X eval 'sub PF_OSI { &AF_OSI;}';
- X eval 'sub PF_X25 { &AF_X25;}';
- X eval 'sub PF_OSINET { &AF_OSINET;}';
- X eval 'sub PF_GOSIP { &AF_GOSIP;}';
- X eval 'sub PF_MAX { &AF_MAX;}';
- X eval 'sub SOMAXCONN {5;}';
- X eval 'sub MSG_OOB {0x1;}';
- X eval 'sub MSG_PEEK {0x2;}';
- X eval 'sub MSG_DONTROUTE {0x4;}';
- X eval 'sub MSG_MAXIOVLEN {16;}';
- X}
- X1;
- END_OF_FILE
- if test 2752 -ne `wc -c <'socket.ph'`; then
- echo shar: \"'socket.ph'\" unpacked with wrong size!
- fi
- # end of 'socket.ph'
- fi
- if test -f 'resolver.pl' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'resolver.pl'\"
- else
- echo shar: Extracting \"'resolver.pl'\" \(4269 characters\)
- sed "s/^X//" >'resolver.pl' <<'END_OF_FILE'
- X#!/usr2/new/bin/perl #-*-perl-*-
- X# a subroutine to resolve a Internet host name to IP address
- X# Copyright (C) Khun Yee Fung (clipper@csd.uwo.ca) 1991
- X# You can do anything to this file except to sell it and/or pretend
- X# you wrote it. You must preserve the copyright notice.
- Xpackage resolver;
- X
- Xsub main'resolver {
- X local($sockaddr) = 'S n a4 x8';
- X local($hostname, $server) = @_;
- X local($port) = 53;
- X
- X if ($server =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
- X $saddr = pack('CCCC', $1, $2, $3, $4);
- X }
- X elsif (!(($name, $aliases, $type, $len, $saddr) = gethostbyname($server))) {
- X return 0;
- X }
- X local($sin) = pack($sockaddr, 2, $port, $saddr);
- X
- X socket(NSERVER, 2, 1, 0) || return 0;
- X connect(NSERVER, $sin) || return 0;
- X
- X select(NSERVER); $| = 1; select(STDOUT); $| = 1;
- X
- X local($len) = 18 + length($hostname);
- X local(@names) = split('\.', $hostname);
- X local($head) = pack('S6', 319, 256, 1, 0, 0, 0);
- X print NSERVER pack('S', $len), $head;
- X local($arg, $response);
- X foreach $arg (@names) {
- X print NSERVER pack('C', length($arg)), $arg;
- X }
- X print NSERVER pack('CS2', 0, 1, 1);
- X
- X read(NSERVER, $len, 2);
- X read(NSERVER, $response, unpack('S', $len));
- X close NSERVER;
- X
- X local(@shead) = unpack('S6', $response);
- X ($shead[1] & 0x0F) == 0 || return 0;
- X
- X local($in) = 12;
- X local($ans) = $shead[2];
- X local($c);
- X while ($ans > 0) {
- X while (($c = ord(substr($response, $in++, 1))) != 0) {
- X $in += $c;
- X }
- X $in += 4;
- X $ans--;
- X }
- X
- X $ans = $shead[3];
- X local($type, $rdlength, $rdata);
- X local(@return);
- X while ($ans > 0) {
- X while (($c = ord(substr($response, $in++, 1))) != 0) {
- X ($c & 0xc0) != 0xc0 || $in++, last;
- X $in += $c;
- X }
- X $type = substr($response, $in, 2);
- X $in += 8;
- X $rdlength = unpack('n', substr($response, $in, 2));
- X $in += 2;
- X $rdata = substr($response, $in, $rdlength);
- X if (unpack('S', $type) == 1) {
- X push(@return, $rdata);
- X }
- X $in += $rdlength;
- X $ans--;
- X }
- X return @return;
- X}
- X
- Xsub main'rresolver {
- X local($sockaddr) = 'S n a4 x8';
- X local($hostname, $server) = @_;
- X local($port) = 53;
- X
- X if ($server =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
- X $saddr = pack('CCCC', $1, $2, $3, $4);
- X }
- X elsif (!(($name, $aliases, $type, $len, $saddr) = gethostbyname($server))) {
- X return 0;
- X }
- X local($sin) = pack($sockaddr, 2, $port, $saddr);
- X
- X socket(NSERVER, 2, 1, 0) || return 0;
- X connect(NSERVER, $sin) || return 0;
- X
- X select(NSERVER); $| = 1; select(STDOUT); $| = 1;
- X
- X local($len) = 18 + length($hostname);
- X local(@names) = split('\.', $hostname);
- X local($head) = pack('S6', 319, 256, 1, 0, 0, 0);
- X print NSERVER pack('S', $len), $head;
- X @names = reverse(@names);
- X push(@names, "in-addr", "arpa");
- X foreach $arg (@names) {
- X print NSERVER pack('C', length($arg)), $arg;
- X }
- X print NSERVER pack('CS2', 0, 12, 1);
- X
- X read(NSERVER, $len, 2);
- X read(NSERVER, $response, unpack('S', $len));
- X close NSERVER;
- X
- X @shead = unpack('S6', $response);
- X ($shead[1] & 0x0F) == 0 || return 0;
- X
- X $in = 12;
- X $ans = $shead[2];
- X while ($ans > 0) {
- X while (($c = ord(substr($response, $in++, 1))) != 0) {
- X $in += $c;
- X }
- X $in += 4;
- X $ans--;
- X }
- X
- X $ans = $shead[3];
- X local($type, $rdlength, $rdata);
- X local(@return);
- X while ($ans > 0) {
- X while (($c = ord(substr($response, $in++, 1))) != 0) {
- X ($c & 0xc0) != 0xc0 || $in++, last;
- X $in += $c;
- X }
- X $type = substr($response, $in, 2);
- X $in += 8;
- X $rdlength = unpack('n', substr($response, $in, 2));
- X $in += 2;
- X $rdata = substr($response, $in, $rdlength);
- X if (unpack('S', $type) == 12) {
- X return(&label());
- X }
- X $in += $rdlength;
- X $ans--;
- X }
- X return 0;
- X}
- X
- Xsub label {
- X $qname = "";
- X $c = substr($response, $in, 1); $in++;
- X $offset = $in;
- X $forward = 1;
- X loop: while ($c ne "\000") {
- X $cc = ord($c);
- X if (($cc & 0xc0) == 0xc0) {
- X if ($forward) {
- X $forward = 0;
- X $in = $offset + 1;
- X }
- X $offset = ($cc - 192) * 256 + ord(substr($response, $offset, 1));
- X }
- X else {
- X $qname = $qname . substr($response, $offset, $cc) . "."; $offset += $cc;
- X }
- X $c = substr($response, $offset, 1); $offset++;
- X }
- X if ($forward) {
- X $in = $offset;
- X }
- X chop($qname);
- X print "$qname\n";
- X}
- X
- X1;
- END_OF_FILE
- if test 4269 -ne `wc -c <'resolver.pl'`; then
- echo shar: \"'resolver.pl'\" unpacked with wrong size!
- fi
- chmod +x 'resolver.pl'
- # end of 'resolver.pl'
- fi
- if test -f 'newgetopt.pl' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'newgetopt.pl'\"
- else
- echo shar: Extracting \"'newgetopt.pl'\" \(5713 characters\)
- sed "s/^X//" >'newgetopt.pl' <<'END_OF_FILE'
- X# newgetopt.pl -- new options parsing #-*-perl-*-
- X
- X# SCCS Status : @(#)@ newgetopt.pl 1.7
- X# Author : Johan Vromans
- X# Created On : Tue Sep 11 15:00:12 1990
- X# Last Modified By: Johan Vromans
- X# Last Modified On: Sun Oct 14 14:35:36 1990
- X# Update Count : 34
- X# Status : Okay
- X
- X# This package implements a new getopt function. This function adheres
- X# to the new syntax (long option names, no bundling).
- X#
- X# Arguments to the function are:
- X#
- X# - a list of possible options. These should designate valid perl
- X# identifiers, optionally followed by an argument specifier ("="
- X# for mandatory arguments or ":" for optional arguments) and an
- X# argument type specifier: "n" or "i" for integer numbers, "f" for
- X# real (fix) numbers or "s" for strings.
- X#
- X# - if the first option of the list consists of non-alphanumeric
- X# characters only, it is interpreted as a generic option starter.
- X# Everything starting with one of the characters from the starter
- X# will be considered an option.
- X# Likewise, a double occurrence (e.g. "--") signals end of
- X# the options list.
- X# The default value for the starter is "-".
- X#
- X# Upon return, the option variables, prefixed with "opt_", are defined
- X# and set to the respective option arguments, if any.
- X# Options that do not take an argument are set to 1. Note that an
- X# option with an optional argument will be defined, but set to '' if
- X# no actual argument has been supplied.
- X# A return status of 0 (false) indicates that the function detected
- X# one or more errors.
- X#
- X# Special care is taken to give a correct treatment to optional arguments.
- X#
- X# E.g. if option "one:i" (i.e. takes an optional integer argument),
- X# then the following situations are handled:
- X#
- X# -one -two -> $opt_one = '', -two is next option
- X# -one -2 -> $opt_one = -2
- X#
- X# Also, assume "foo=s" and "bar:s" :
- X#
- X# -bar -xxx -> $opt_bar = '', '-xxx' is next option
- X# -foo -bar -> $opt_foo = '-bar'
- X# -foo -- -> $opt_foo = '--'
- X#
- X
- X# HISTORY
- X# 20-Sep-1990 Johan Vromans
- X# Set options w/o argument to 1.
- X# Correct the dreadful semicolon/require bug.
- X
- X
- Xpackage newgetopt;
- X
- X$debug = 0; # for debugging
- X
- Xsub main'NGetOpt {
- X local (@optionlist) = @_;
- X local ($[) = 0;
- X local ($genprefix) = "-";
- X local ($error) = 0;
- X local ($opt, $optx, $arg, $type, $mand, @hits);
- X
- X # See if the first element of the optionlist contains option
- X # starter characters.
- X $genprefix = shift (@optionlist) if $optionlist[0] =~ /^\W+$/;
- X
- X # Turn into regexp.
- X $genprefix =~ s/(\W)/\\\1/g;
- X $genprefix = "[" . $genprefix . "]";
- X
- X # Verify correctness of optionlist.
- X @hits = grep ($_ !~ /^\w+([=:][infse])?$/, @optionlist);
- X if ( $#hits >= 0 ) {
- X foreach $opt ( @hits ) {
- X print STDERR ("Error in option spec: \"", $opt, "\"\n");
- X $error++;
- X }
- X return 0;
- X }
- X
- X # Process argument list
- X
- X while ( $#main'ARGV >= 0 ) { #'){
- X
- X # >>> See also the continue block <<<
- X
- X # Get next argument
- X $opt = shift (@main'ARGV); #');
- X print STDERR ("=> option \"", $opt, "\"\n") if $debug;
- X $arg = undef;
- X
- X # Check for exhausted list.
- X if ( $opt =~ /^$genprefix/o ) {
- X # Double occurrence is terminator
- X return ($error == 0) if $opt eq "$+$+";
- X $opt = $'; # option name (w/o prefix)
- X }
- X else {
- X # Apparently not an option - push back and exit.
- X unshift (@main'ARGV, $opt); #');
- X return ($error == 0);
- X }
- X
- X # Grep in option list. Hide regexp chars from option.
- X ($optx = $opt) =~ s/(\W)/\\\1/g;
- X @hits = grep (/^$optx([=:].+)?$/, @optionlist);
- X if ( $#hits != 0 ) {
- X print STDERR ("Unknown option: ", $opt, "\n");
- X $error++;
- X next;
- X }
- X
- X # Determine argument status.
- X undef $type;
- X $type = $+ if $hits[0] =~ /[=:].+$/;
- X print STDERR ("=> found \"$hits[0]\" for ", $opt, "\n") if $debug;
- X
- X # If it is an option w/o argument, we're almost finished with it.
- X if ( ! defined $type ) {
- X $arg = 1; # supply explicit value
- X next;
- X }
- X
- X # Get mandatory status and type info.
- X ($mand, $type) = $type =~ /^(.)(.)$/;
- X
- X # Check if the argument list is exhausted.
- X if ( $#main'ARGV < 0 ) { #'){
- X
- X # Complain if this option needs an argument.
- X if ( $mand eq "=" ) {
- X print STDERR ("Option ", $opt, " requires an argument\n");
- X $error++;
- X }
- X next;
- X }
- X
- X # Get (possibly optional) argument.
- X $arg = shift (@main'ARGV); #');
- X
- X # Check if it is a valid argument. A mandatory string takes
- X # anything.
- X if ( "$mand$type" ne "=s" && $arg =~ /^$genprefix/o ) {
- X
- X # Check for option list terminator.
- X if ( $arg eq "$+$+" ) {
- X # Complain if an argument is required.
- X if ($mand eq "=") {
- X print STDERR ("Option ", $opt, " requires an argument\n");
- X $error++;
- X }
- X # Push back so the outer loop will terminate.
- X unshift (@main'ARGV, $arg); #');
- X $arg = ""; # don't assign it
- X next;
- X }
- X
- X # Maybe the optional argument is the next option?
- X if ( $mand eq ":" && $' =~ /[a-zA-Z_]/ ) {
- X # Yep. Push back.
- X unshift (@main'ARGV, $arg); #');
- X $arg = ""; # don't assign it
- X next;
- X }
- X }
- X
- X if ( $type eq "n" || $type eq "i" ) { # numeric/integer
- X if ( $arg !~ /^-?[0-9]+$/ ) {
- X print STDERR ("Value \"", $arg, "\" invalid for option ",
- X $opt, " (numeric required)\n");
- X $error++;
- X }
- X next;
- X }
- X
- X if ( $type eq "f" ) { # fixed real number, int is also ok
- X if ( $arg !~ /^-?[0-9.]+$/ ) {
- X print STDERR ("Value \"", $arg, "\" invalid for option ",
- X $opt, " (real number required)\n");
- X $error++;
- X }
- X next;
- X }
- X
- X if ( $type eq "s" ) { # string
- X next;
- X }
- X
- X }
- X continue {
- X print STDERR ("=> \$main'opt_$opt = $arg\n") if $debug;
- X eval ("\$main'opt_$opt = \$arg");
- X }
- X
- X return ($error == 0);
- X}
- X1;
- END_OF_FILE
- if test 5713 -ne `wc -c <'newgetopt.pl'`; then
- echo shar: \"'newgetopt.pl'\" unpacked with wrong size!
- fi
- # end of 'newgetopt.pl'
- fi
- if test -f 'archie.depend' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'archie.depend'\"
- else
- echo shar: Extracting \"'archie.depend'\" \(750 characters\)
- sed "s/^X//" >'archie.depend' <<'END_OF_FILE'
- X$nsserver = "129.100.1.23"; # the IP address of the domain server
- X # or a hostname with its IP address in your
- X # host table. If you have the resolver library
- X # in your libc, don't worry about this variable.
- X
- X$startup = './system.archierc'; # The system startup file to be read
- X # for each job. Used to set host order,
- X # for example.
- X
- X$serverip = '132.206.2.3'; # The IP of the archie server in your area.
- X # Use 128.214.6.100 in Northern Europe?
- X
- X$servername = 'quiche.cs.mcgill.ca'; # The archie address of the archie server.
- X # "nic.funet.fi" in Northern Europe?
- X
- X1;
- END_OF_FILE
- if test 750 -ne `wc -c <'archie.depend'`; then
- echo shar: \"'archie.depend'\" unpacked with wrong size!
- fi
- # end of 'archie.depend'
- fi
- if test -f 'archie.examples' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'archie.examples'\"
- else
- echo shar: Extracting \"'archie.examples'\" \(922 characters\)
- sed "s/^X//" >'archie.examples' <<'END_OF_FILE'
- XThe default format string is (between the '--' lines):
- X--
- X%02seq Host %host
- X
- X Location: %dir
- X %type %mode %size %date %name
- X
- X--
- XIf you want to specify it on the command line, you do this:
- X
- X$ archie -format '%02seq Host %host\n\n Location: %dir\n\
- X %type %mode %date %name' word
- X
- XNotice the single quotes used. This is to prevent the shell from
- Xinterpreting it.
- X
- XIf you want, you can put it in a file, say archie.format, and use the
- X-ffile option:
- X
- X$ archie -ffile archie.format word
- X
- XI usually need only about 10 hits. But the server does not always give
- Xme about 20. So I set the maximum hit to be 40. On command line, I specify
- X
- X$ archie -match 40 vgrind
- X
- XBe careful to single quote any regular expressions you have. Notice:
- Xthe regular expression syntax is out of the control of the program.
- XRead the help file on quiche.cs.mcgill.ca to read for yourself.
- X
- X$ archie -match 40 -reg '*grind*'
- X
- XKhun Yee
- END_OF_FILE
- if test 922 -ne `wc -c <'archie.examples'`; then
- echo shar: \"'archie.examples'\" unpacked with wrong size!
- fi
- # end of 'archie.examples'
- fi
- if test -f 'DOT.archierc' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'DOT.archierc'\"
- else
- echo shar: Extracting \"'DOT.archierc'\" \(77 characters\)
- sed "s/^X//" >'DOT.archierc' <<'END_OF_FILE'
- Xmatch 40
- Xformat
- X%02seq %host
- XLocation: %dir
- X%10type %mode %8size %date %name
- END_OF_FILE
- if test 77 -ne `wc -c <'DOT.archierc'`; then
- echo shar: \"'DOT.archierc'\" unpacked with wrong size!
- fi
- # end of 'DOT.archierc'
- fi
- if test -f 'system.archierc' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'system.archierc'\"
- else
- echo shar: Extracting \"'system.archierc'\" \(122 characters\)
- sed "s/^X//" >'system.archierc' <<'END_OF_FILE'
- Xmatch 40
- Xdomain ca edu com gov net de se nl fi au nz
- Xformat
- X%02seq %host
- XLocation: %dir
- X%10type %mode %8size %date %name
- END_OF_FILE
- if test 122 -ne `wc -c <'system.archierc'`; then
- echo shar: \"'system.archierc'\" unpacked with wrong size!
- fi
- # end of 'system.archierc'
- fi
- echo shar: End of shell archive.
- exit 0
-
- exit 0 # Just in case...
-